Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / pssst.arc / PSEDITS.PRG < prev next >

Wrap

Text File | 1986-08-14 | 6.4 KB | 210 lines

* PSEDITS.PRG * * A DBASE II 16BIT COMMAND FILE to allow input or creation of * filename, and select from the major branches of the PSSST system. * * Version 1 * By LTC Denny Hugg * ANGSC/DOS Andrews AFB MD 16 Jul 1985 * * Version 2 * modified by Maj Jim McMurry * ANGSC/DOSC Truax Field, WI 15 Jun 1986 * ERASE * --- both indexes active in case due date or priority changed USE &gsusfile GO BOTTOM STORE # TO last IF last = 0 ERASE STORE 10 TO line STORE 'You Have Nothing In Your Suspense File '+gfirstname TO prompt DO PSPROMPT STORE 0 TO counter DO WHILE counter < gdelay STORE counter + 1 TO counter ENDDO RELEASE ALL EXCEPT g* RETURN ENDIF * --- we want both indexes updated in case those two fields are edited * --- and certainly in the case records are completed or deleted USE &gsusfile INDEX &gsusindex, &gpryindex STORE 'N' TO needpack GO TOP DO WHILE T STORE 0 TO counter CLEAR GETS ERASE * --- uses selection from psjobtrk menu to branch to appropriate module DO CASE CASE gc=3 STORE 'LISTING SUSPENSE ITEMS FOR EDIT' TO heading CASE gc=5 STORE 'LISTING SUSPENSE ITEMS FOR COMPLETION' TO heading CASE gc=7 STORE 'LISTING SUSPENSE ITEMS FOR DELETION' TO heading ENDCASE DO PSHEADING @ 5, 0 SAY 'Rec# Description' @ 5,70 SAY 'Due Date' @ 6, 0 SAY gline @ 6,78 SAY ' ' STORE # TO firstshown * --- display 14 records at a time DO WHILE .NOT. EOF .AND. counter < 14 IF * SKIP ELSE DISPLAY ' ' + descrip, + ' '+ duedate SKIP STORE counter + 1 TO counter ENDIF ENDDO STORE ' ' TO select @ 0, 0 SAY gcuron @ 22,79 SAY ' '; + 'Enter Record To Work On Or <Return> To Continue '; GET select PICTURE '99999' READ NOUPDATE @ 0, 0 SAY gcuroff @ 22,79 SAY gclearline IF select = ' ' * --- this is the only exit as we want him reviewing all suspenses IF EOF ERASE STORE 10 TO line STORE 'Thats The End Of Your Records '+gfirstname; +' Returning To JobTrack' TO prompt DO PSPROMPT IF needpack = 'N' STORE 0 TO timer DO WHILE timer < gdelay STORE timer + 1 TO timer ENDDO ELSE * --- don't need a timer as pack takes awhile PACK ENDIF USE RELEASE ALL EXCEPT g* RETURN ELSE * --- go back and display some more records LOOP ENDIF ELSE IF $(select,1,1) = ' ' * --- he added some leading space(s) STORE 1 TO pointer * --- locate the first non-empty character DO WHILE $(select,pointer,1) = ' ' STORE pointer + 1 TO pointer ENDDO * --- get the non-empty characters STORE $(select,pointer,LEN(select)-pointer + 1) TO select ENDIF RELEASE pointer * --- we may use this if the record doesn't exist STORE TRIM(select) TO temp * --- make the record number a standard length for display STORE temp TO select STORE '0000' TO zeros STORE $(zeros,1,5-LEN(select)) + select TO select STORE VAL(select) TO recno RELEASE zeros ENDIF * --- make sure he doesn't enter a bogus record number IF recno > last @ 22,79 SAY gclearline * --- temp2 is still the string version of recno @ 22,79 SAY ' '; + 'There Is No ' + temp + ' In Your Database' STORE 1 TO timer DO WHILE timer < gdelay STORE timer + 1 TO timer ENDDO @ 22, 79 SAY gclearline RELEASE temp GO firstshown LOOP ENDIF RELEASE select GO recno DO CASE CASE gc = 3 ERASE STORE 2 TO line STORE 'E D I T S U S P E N S E I T E M S' TO prompt DO PSPROMPT @ 0, 0 SAY gcuron @ 5, 0 SAY 'Description '; GET descrip @ 7, 1 SAY 'Origin '; GET origin picture '!!!!!!!!' @ 7,29 SAY 'Priority .' @ 7,38 GET priority PICTURE '9.99' @ 7,53 SAY 'Date Received / /' @ 7,67 GET in:date PICTURE '99/99/99' @ 9, 4 SAY 'Due / /' @ 9, 8 GET duedate PICTURE '99/99/99' @ 9,34 SAY 'OPR '; GET opr PICTURE '!!!!' @ 9,57 SAY 'Phone - -' @ 9,63 GET phone PICTURE '999-999-9999' @ 11, 0 SAY 'Remarks '; GET rem1 @ 12, 8 GET rem2 @ 13, 8 GET rem3 @ 14, 8 GET rem4 @ 15, 8 GET rem5 @ 16, 8 GET rem6 @ 17, 8 GET rem7 @ 18, 8 GET rem8 @ 19, 8 GET rem9 @ 20, 8 GET rem10 @ 21, 8 GET rem11 @ 22, 8 GET rem12 READ @ 0, 0 SAY gcuroff * --- test descrip for presence of a semi-colon then get rid of it * --- by replacing it with a space. semi-colons really screw up the * --- printouts, so it's worth the time. * --- trap out a semi-colon in the last column IF $(descrip,55,1) = ';' STORE $(descrip,1,54) TO half1 REPLACE descrip WITH half1 ENDIF * --- trap out a semi-colon in the first column IF $(descrip,1,1) = ';' STORE $(descrip,2,55) TO half1 REPLACE descrip WITH half1 ENDIF * --- trap out any semi-colons in between STORE 1 TO pointer DO WHILE pointer < 56 IF $(descrip,pointer,1) = ';' STORE $(descrip,1,pointer-1) TO half1 STORE $(descrip,pointer+1,55-pointer) TO half2 REPLACE descrip WITH half1 + ' ' + half2 ENDIF STORE pointer + 1 TO pointer ENDDO * --- redisplay the list of records just as they were unless we * changed the first record displayed IF # <> firstshown GO firstshown ELSE GO TOP ENDIF CASE gc = 5 RELEASE select, zeros DO PSCOMPLT CASE gc = 7 RELEASE select, zeros DO PSDELETE ENDCASE ENDDO T * EOF PSEDITS.PRG